home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / graphic / 1svga.zip / MENU_TXT.PAS < prev    next >
Pascal/Delphi Source File  |  1994-04-29  |  3KB  |  97 lines
  1. { Text Menu }
  2.  
  3. uses Txt;
  4.  
  5. type MenuType=record
  6.        LenX,LenY,PosX,P:integer;
  7.        Name:string[10];
  8.      end;
  9. const
  10.   SubNum=4;
  11.   MenuP:integer=1;    { Text,Select,Border }
  12.   MenuColor:array[1..3] of byte=($3E,$1F,$31);
  13.   Sub:array[1..SubNum] of MenuType=(
  14.     (LenX:13;LenY:8;PosX: 5;P:1;Name:'Menu-1'),
  15.     (LenX:13;LenY:8;PosX:15;P:1;Name:'Menu-2'),
  16.     (LenX:13;LenY:8;PosX:25;P:1;Name:'Menu-3'),
  17.     (LenX:13;LenY:8;PosX:35;P:1;Name:'Menu-4'));
  18.   SubName:array[1..32] of string[13]=(
  19.     'Pet Shop Boys','Pet Shop Boys','Pet Shop Boys','Pet Shop Boys',
  20.     'Pet Shop Boys','Pet Shop Boys','Pet Shop Boys','Pet Shop Boys',
  21.     'Pet Shop Boys','Pet Shop Boys','Pet Shop Boys','Pet Shop Boys',
  22.     'Pet Shop Boys','Pet Shop Boys','Pet Shop Boys','Pet Shop Boys',
  23.     'Pet Shop Boys','Pet Shop Boys','Pet Shop Boys','Pet Shop Boys',
  24.     'Pet Shop Boys','Pet Shop Boys','Pet Shop Boys','Pet Shop Boys',
  25.     'Pet Shop Boys','Pet Shop Boys','Pet Shop Boys','Pet Shop Boys',
  26.     'Pet Shop Boys','Pet Shop Boys','Pet Shop Boys','Pet Shop Boys');
  27.  
  28. { ─────────────── SubMenu ─────────────── }
  29. function SubMenu:integer;
  30. var Start,I,X,Y,Xi,P,K:integer;
  31.     Buf:pointer;
  32. begin
  33.   Start:=1; for I:=1 to MenuP-1 do Inc(Start,Sub[I].LenY);
  34.   X:=Sub[MenuP].LenX;  Y:=Sub[MenuP].LenY;
  35.   Xi:=Sub[MenuP].PosX; P:=Sub[MenuP].P;
  36.   GetMem(Buf,4000); GetText(Xi-1,2,X+5,Y+3,Buf^);
  37.   TextBox(Xi-1,2,X+4,Y+2,MenuColor[3],1); TextShadow(Xi-1,2,X+4,Y+2);
  38.   for I:=1 to Y do PrintText(Xi,I+2,MenuColor[1],' '+SubName[Start+I-1]+' ');
  39.   repeat
  40.     PrintText(Xi,P+2,MenuColor[2],' '+SubName[Start+P-1]+' ');
  41.     K:=Key;
  42.     PrintText(Xi,P+2,MenuColor[1],' '+SubName[Start+P-1]+' ');
  43.     case K of
  44.       $4800:Dec(P); $5000:Inc(P);    { Up, Down }
  45.     end;
  46.     if P<1 then P:=Y; if P>Y then P:=1;
  47.   until (K=$4B00) or (K=$4D00) or (K=$1C0D) or (K=$011B);
  48.   Sub[MenuP].P:=P;
  49.   PutText(Xi-1,2,X+5,Y+3,Buf^); FreeMem(Buf,4000);
  50.   SubMenu:=K;
  51. end;
  52. { ─────────────── MainMenu ─────────────── }
  53. function MainMenu:integer;
  54. var Start,K:integer;
  55. begin
  56.   Start:=0;
  57.   repeat
  58.     PrintText(Sub[MenuP].PosX-1,1,MenuColor[2],' '+Sub[MenuP].Name+' ');
  59.     case Start of
  60.       0:begin
  61.       K:=Key;
  62.       if (K=$1C0D) or (K=$5000) then begin K:=SubMenu; Start:=1; end;
  63.     end;
  64.       1:begin
  65.       K:=SubMenu;    { Uncomment if wnat to return to MainMenu }
  66.       { if (K=$1C0D) or (K=$011B) then begin Start:=0; K:=0; end; }
  67.     end;
  68.     end;
  69.     PrintText(Sub[MenuP].PosX-1,1,MenuColor[1],' '+Sub[MenuP].Name+' ');
  70.     case K of
  71.       $4B00:Dec(MenuP); $4D00:Inc(MenuP);    { Left, Right }
  72.     end;
  73.     if MenuP<1 then MenuP:=SubNum; if MenuP>SubNum then MenuP:=1;
  74.   until (K=$1C0D) or (K=$011B);
  75.   MainMenu:=0;
  76.   if K=$1C0D then begin
  77.     Start:=0; for K:=1 to MenuP-1 do Inc(Start,Sub[K].LenY);
  78.     MainMenu:=Start+Sub[MenuP].P;
  79.   end;
  80. end;
  81. { ─────────────── Screen ─────────────── }
  82. procedure Screen;
  83. var I:integer;
  84. begin
  85.   TextBar(1, 1,80, 1,MenuColor[1],' ');
  86.   TextBar(1, 2,80,23,$10,' ');
  87.   TextBar(1,25,80, 1,MenuColor[1],' ');
  88.   for I:=1 to SubNum do PrintText(Sub[I].PosX,1,MenuColor[1],Sub[I].Name);
  89.   PrintText(5,25,MenuColor[1],'Text Menu');
  90.   TextBox(1,2,80,23,$1F,2);
  91. end;
  92.  
  93. begin
  94.   Screen;
  95.   PrintNum(40,12,$2F,MainMenu);
  96. end.
  97.